home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0007_SB-VOC.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  165 lines
  1. { JR> Well, Can you post the sorce code on how to play to the Sound blaster
  2.  JR> Byte by Byte? I could probley find out after that!
  3.  JR> James
  4.  
  5. Sure thing... this Program will load a File into memory then play it a Byte
  6. at a time... It should be pretty self-explanatory.
  7. }
  8.  
  9. Program rawdemo;
  10.  
  11. Uses Crt;
  12.  
  13. {$I-}
  14.  
  15. Const
  16.    fname = 'NELLAF.VOC';               { Can be any raw data File }
  17.    resetport  = $226;
  18.    readport   = $22A;
  19.    Writeport  = $22C;
  20.    statusport = $22E;
  21.    dac_Write  = $10;
  22.    adc_read   = $20;
  23.    midi_read  = $30;
  24.    midi_Write = $38;
  25.    speakeron  = $D1;
  26.    speakeroff = $D3;
  27.  
  28. Function reset_dsp : Boolean;
  29. Var
  30.    count, bdum : Byte;
  31. begin
  32.    reset_dsp := False;
  33.    port[resetport] := 1;
  34.    For count := 1 to 6 do
  35.       bdum := port[statusport];
  36.    port[resetport] := 0;
  37.    For count := 1 to 6 do
  38.       bdum := port[statusport];
  39.    Repeat Until port[statusport] > $80;
  40.     if port[readport] = $AA then
  41.       reset_dsp := True;
  42. end;
  43.  
  44. Procedure spk_on;
  45. begin
  46.    Repeat Until port[Writeport] < $80;
  47.    port[Writeport] := $D1;
  48. end;
  49.  
  50. Procedure spk_off;
  51. begin
  52.    Repeat Until port[Writeport] < $80;
  53.    port[Writeport] := $D3;
  54. end;
  55.  
  56. Procedure generic(reg,cmd:Integer; data:Byte);
  57. begin
  58.    Repeat Until port[Writeport] < $80;
  59.    port[reg] := cmd;
  60.    Repeat Until port[Writeport] < $80;
  61.    port[reg] := data;
  62. end;
  63.  
  64. Procedure Write_dsp(data:Byte); Assembler;
  65. Asm
  66.    mov   dx,$22C
  67.    mov   cx,6                          { Change either value of CX For }
  68. @1:
  69.    in    al,dx
  70.    loop  @1
  71.  
  72.    mov   al,10h
  73.    out   dx,al
  74.    mov   cx,36                         { faster or slower playing. }
  75. @2:
  76.    in    al,dx
  77.    loop  @2
  78.  
  79.    mov   al,data
  80.    out   dx,al
  81. end;
  82.  
  83. Function read_dsp : Byte;
  84. begin
  85.    Repeat Until port[Writeport] < $80;
  86.      port[Writeport] := $20;
  87.    Repeat Until port[statusport] > $80;
  88.    read_dsp := port[readport];
  89. end;
  90.  
  91. Procedure Write_midi(data:Byte);
  92. begin
  93.    Repeat Until port[Writeport] < $80;
  94.    port[Writeport] := $38;
  95.    Repeat Until port[Writeport] < $80;
  96.    port[Writeport] := data;
  97. end;
  98.  
  99. Function read_midi : Byte;
  100. begin
  101.    Repeat Until port[Writeport] < $80;
  102.    port[Writeport] := $30;
  103.    Repeat Until port[statusport] > $80;
  104.    read_midi := port[readport];
  105. end;
  106.  
  107. Function loadFile(Var buffer:Pointer; Filename:String) : Word;
  108. Var
  109.    fromf : File;
  110.    size : LongInt;
  111.    errcode : Integer;
  112. begin
  113.    assign(fromf,Filename);
  114.    reset(fromf,1);
  115.    errcode := ioresult;
  116.    if errcode = 0 then
  117.    begin
  118.       size := Filesize(fromf);
  119.       Writeln(size);
  120.       getmem(buffer,size);
  121.       blockread(fromf,buffer^,size);
  122.    end
  123.    else size := 0;
  124.    loadFile := size;
  125.    close(fromf);
  126. end;
  127.  
  128. Procedure unload(buffer:Pointer; size:Word);
  129. begin
  130.    freemem(buffer,size);
  131. end;
  132.  
  133. Var
  134.    ch : Char;
  135.    buf : Pointer;
  136.    index, fsize : Word;
  137.  
  138. begin
  139.    ClrScr;
  140.    Writeln;
  141.    Writeln;
  142.    if not reset_dsp then
  143.    begin
  144.       Writeln('Unable to initialize SoundBlaster.');
  145.       halt(1);
  146.    end;
  147.    fsize := loadFile(buf,fname);
  148.    if (fsize <= 0) then
  149.    begin
  150.       Writeln(fname, ' not found.');
  151.       halt(2);
  152.    end;
  153. {   For index := 1 to fsize do
  154.       dec(mem[seg(buf^):ofs(buf^)+index-1],80);}       { For MOD samples }
  155.    spk_on;
  156.    Writeln('Playing...');
  157.    For index := 1 to fsize do
  158.       Write_dsp(mem[seg(buf^):ofs(buf^)+index-1]);
  159.    spk_off;
  160.    unload(buf,fsize);
  161.    Writeln('Done.');
  162.    ch := ReadKey;
  163. end.
  164.  
  165.